home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / runner1a / cregistr next >
Text File  |  1999-09-14  |  21KB  |  580 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "cRegistry"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Option Explicit
  11. Private Const KEY_QUERY_VALUE = &H1
  12. Private Const KEY_SET_VALUE = &H2
  13. Private Const KEY_CREATE_SUB_KEY = &H4
  14. Private Const KEY_ENUMERATE_SUB_KEYS = &H8
  15. Private Const KEY_NOTIFY = &H10
  16. Private Const KEY_CREATE_LINK = &H20
  17. Private Const KEY_ALL_ACCESS = &H3F
  18. Private Const REG_OPTION_NON_VOLATILE = 0&
  19. Private Const REG_OPTION_VOLATILE = &H1
  20. Private Const REG_CREATED_NEW_KEY = &H1
  21. Private Const REG_OPENED_EXISTING_KEY = &H2
  22. Private Const STANDARD_RIGHTS_ALL = &H1F0000
  23. Private Const SPECIFIC_RIGHTS_ALL = &HFFFF
  24. Private Const ERROR_SUCCESS = 0&
  25. Private Const ERROR_ACCESS_DENIED = 5
  26. Private Const ERROR_INVALID_DATA = 13&
  27. Private Const ERROR_MORE_DATA = 234
  28. Private Const ERROR_NO_MORE_ITEMS = 259
  29. Private Type SECURITY_ATTRIBUTES
  30.   nLength As Long
  31.   lpSecurityDescriptor As Long
  32.   bInheritHandle As Boolean
  33. End Type
  34.  
  35. Private Type FILETIME
  36.   dwLowDateTime As Long
  37.   dwHighDateTime As Long
  38. End Type
  39.  
  40. Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" _
  41.   (ByVal hkey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
  42.   ByVal samDesired As Long, phkResult As Long) As Long
  43.  
  44. Private Declare Function RegSetValueExStr Lib "advapi32" Alias "RegSetValueExA" _
  45.   (ByVal hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
  46.    ByVal dwType As Long, ByVal szData As String, ByVal cbData As Long) As Long
  47. Private Declare Function RegSetValueExLong Lib "advapi32" Alias "RegSetValueExA" _
  48.   (ByVal hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
  49.    ByVal dwType As Long, szData As Long, ByVal cbData As Long) As Long
  50. Private Declare Function RegSetValueExByte Lib "advapi32" Alias "RegSetValueExA" _
  51.   (ByVal hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
  52.    ByVal dwType As Long, szData As Byte, ByVal cbData As Long) As Long
  53.  
  54. Private Declare Function RegCloseKey Lib "advapi32" (ByVal hkey As Long) As Long
  55.  
  56. Private Declare Function RegQueryValueExStr Lib "advapi32" Alias "RegQueryValueExA" _
  57.   (ByVal hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
  58.    ByRef lpType As Long, ByVal szData As String, ByRef lpcbData As Long) As Long
  59. Private Declare Function RegQueryValueExLong Lib "advapi32" Alias "RegQueryValueExA" _
  60.   (ByVal hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
  61.    ByRef lpType As Long, szData As Long, ByRef lpcbData As Long) As Long
  62. Private Declare Function RegQueryValueExByte Lib "advapi32" Alias "RegQueryValueExA" _
  63.   (ByVal hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
  64.    ByRef lpType As Long, szData As Byte, ByRef lpcbData As Long) As Long
  65.    
  66. Private Declare Function RegCreateKeyEx Lib "advapi32" Alias "RegCreateKeyExA" _
  67.   (ByVal hkey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, _
  68.    ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, _
  69.    lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, _
  70.    lpdwDisposition As Long) As Long
  71.  
  72. Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" _
  73.   (ByVal hkey As Long, ByVal dwIndex As Long, ByVal lpName As String, _
  74.    lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, _
  75.    lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
  76.  
  77. Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" ( _
  78.     ByVal hkey As Long, ByVal dwIndex As Long, ByVal lpName As String, _
  79.     ByVal cbName As Long) As Long
  80.  
  81. Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" _
  82.   (ByVal hkey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, _
  83.    lpcbValueName As Long, ByVal lpReserved As Long, ByVal lpType As Long, _
  84.    ByVal lpData As Long, ByVal lpcbData As Long) As Long
  85.    
  86. Private Declare Function RegEnumValueLong Lib "advapi32.dll" Alias "RegEnumValueA" _
  87.   (ByVal hkey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, _
  88.    lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, _
  89.    lpData As Long, lpcbData As Long) As Long
  90. Private Declare Function RegEnumValueStr Lib "advapi32.dll" Alias "RegEnumValueA" _
  91.   (ByVal hkey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, _
  92.    lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, _
  93.    ByVal lpData As String, lpcbData As Long) As Long
  94. Private Declare Function RegEnumValueByte Lib "advapi32.dll" Alias "RegEnumValueA" _
  95.   (ByVal hkey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, _
  96.    lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, _
  97.    lpData As Byte, lpcbData As Long) As Long
  98.  
  99. Private Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" _
  100.    (ByVal hkey As Long, ByVal lpClass As String, _
  101.    lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, _
  102.    lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, _
  103.    lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, _
  104.    lpftLastWriteTime As Any) As Long
  105.  
  106. Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
  107.   (ByVal hkey As Long, ByVal lpSubKey As String) As Long
  108.  
  109. Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
  110.   (ByVal hkey As Long, ByVal lpValueName As String) As Long
  111.  
  112. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
  113.     lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
  114. Private Declare Function ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long) As Long
  115.  
  116.  
  117. Public Enum ERegistryClassConstants
  118.     HKEY_CLASSES_ROOT = &H80000000
  119.     HKEY_CURRENT_USER = &H80000001
  120.     HKEY_LOCAL_MACHINE = &H80000002
  121.     HKEY_USERS = &H80000003
  122. End Enum
  123.  
  124. Public Enum ERegistryValueTypes
  125.     REG_NONE = (0)
  126.     REG_SZ = (1)
  127.     REG_EXPAND_SZ = (2)
  128.     REG_BINARY = (3)
  129.     REG_DWORD = (4)
  130.     REG_DWORD_LITTLE_ENDIAN = (4)
  131.     REG_DWORD_BIG_ENDIAN = (5)
  132.     REG_LINK = (6)
  133.     REG_MULTI_SZ = (7)
  134.     REG_RESOURCE_LIST = (8)
  135.     REG_FULL_RESOURCE_DESCRIPTOR = (9)
  136.     REG_RESOURCE_REQUIREMENTS_LIST = (10)
  137. End Enum
  138.  
  139. Private m_hClassKey As Long
  140. Private m_sSectionKey As String
  141. Private m_sValueKey As String
  142. Private m_vValue As Variant
  143. Private m_sSetValue As String
  144. Private m_vDefault As Variant
  145. Private m_eValueType As ERegistryValueTypes
  146.  
  147. Public Property Get KeyExists() As Boolean
  148. Dim hkey As Long
  149.     If RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, 1, hkey) = ERROR_SUCCESS Then
  150.         KeyExists = True
  151.         RegCloseKey hkey
  152.     Else
  153.         KeyExists = False
  154.     End If
  155.     
  156. End Property
  157. Public Function CreateKey() As Boolean
  158. Dim tSA As SECURITY_ATTRIBUTES
  159. Dim hkey As Long
  160. Dim lCreate As Long
  161. Dim e As Long
  162.     e = RegCreateKeyEx(m_hClassKey, m_sSectionKey, 0, "", REG_OPTION_NON_VOLATILE, _
  163.                  KEY_ALL_ACCESS, tSA, hkey, lCreate)
  164.     If e Then
  165.         Err.Raise 26001, App.EXEName & ".cRegistry", "Failed to create registry Key: '" & m_sSectionKey
  166.     Else
  167.         CreateKey = (e = ERROR_SUCCESS)
  168.         RegCloseKey hkey
  169.     End If
  170. End Function
  171. Public Function DeleteKey() As Boolean
  172. Dim e As Long
  173.     e = RegDeleteKey(m_hClassKey, m_sSectionKey)
  174.     If e Then
  175.         Err.Raise 26001, App.EXEName & ".cRegistry", "Failed to delete registry Key: '" & m_hClassKey & "',Section: '" & m_sSectionKey
  176.     Else
  177.         DeleteKey = (e = ERROR_SUCCESS)
  178.     End If
  179.     
  180. End Function
  181. Public Function DeleteValue() As Boolean
  182. Dim e As Long
  183. Dim hkey As Long
  184.  
  185.     e = RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, KEY_ALL_ACCESS, hkey)
  186.     If e Then
  187.         Err.Raise 26001, App.EXEName & ".cRegistry", "Failed to open key '" & m_hClassKey & "',Section: '" & m_sSectionKey & "' for delete access"
  188.     Else
  189.         e = RegDeleteValue(hkey, m_sValueKey)
  190.